home *** CD-ROM | disk | FTP | other *** search
/ HPAVC / HPAVC CD-ROM.iso / TUT10NEW.ZIP / TUT10.PAS < prev    next >
Pascal/Delphi Source File  |  1995-02-02  |  10KB  |  265 lines
  1. (*****************************************************************************)
  2. (*                                                                           *)
  3. (* TUT9.PAS - VGA Trainer Program 10 (in Pascal)                             *)
  4. (*                                                                           *)
  5. (* "The VGA Trainer Program" was originally written by Denthor of            *)
  6. (* Asphyxia.  It contained some nice pascal source and documentation.        *)
  7. (* But then Snowman came along.  He saw disorder, he saw inefficiency,       *)
  8. (* he saw PASCAL.  Denthor couldn't stop Snowman, so Snowman went on to      *)
  9. (* convert tha pascal source to C++.  ...and the people were happy.          *)
  10. (*                                                                           *)
  11. (* Program Notes : This program presents Chain-4.                            *)
  12. (*                                                                           *)
  13. (* Author        : Grant Smith (Denthor)  - denthor@beastie.cs.und.ac.za     *)
  14. (*                                                                           *)
  15. (*****************************************************************************)
  16.  
  17. Uses Crt,GFX;
  18.  
  19. Const Size : Byte = 80;      { Size =  40 = 1 across, 4 down }
  20.                              { Size =  80 = 2 across, 2 down }
  21.                              { Size = 160 = 4 across, 1 down }
  22.  
  23.       bit : Array [1..897] of byte = (
  24. 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,33,2,151,5,149,6,148,7,147,8,49,2,95,8,49,
  25. 4,93,9,49,3,93,4,2,3,49,4,92,4,3,3,48,4,92,4,3,4,48,4,91,4,4,3,48,4,92,4,3,4,
  26. 48,3,58,2,32,4,4,4,47,4,57,3,31,4,5,3,48,3,57,4,30,4,5,4,47,3,57,5,29,4,6,4,46,
  27. 4,57,4,29,4,7,3,47,3,58,2,30,4,7,4,46,4,90,4,7,4,46,3,90,4,8,4,27,2,16,3,90,4,
  28. 8,9,22,3,16,3,89,4,5,13,8,6,8,3,15,3,90,4,2,15,6,10,6,3,16,3,6,1,21,1,9,2,7,1,
  29. 21,6,14,18,9,5,2,4,5,4,1,4,10,3,4,5,10,2,7,3,8,2,5,3,9,3,7,8,13,13,1,4,9,4,5,3,
  30. 5,3,1,6,9,3,3,6,9,4,5,4,8,3,3,4,9,3,6,9,11,10,6,4,8,4,6,3,4,11,8,3,2,7,9,5,4,4,
  31. 9,3,2,4,9,3,6,4,4,2,8,10,9,4,7,4,6,3,5,5,3,3,8,3,1,8,8,5,4,5,8,3,3,3,9,4,5,4,5,
  32. 2,5,10,12,4,7,3,5,5,4,5,4,3,7,3,1,4,1,3,9,4,5,4,9,3,2,3,10,3,6,3,5,3,4,10,13,3,
  33. 8,3,2,7,5,4,5,3,7,7,1,3,9,4,5,5,9,3,1,3,10,3,6,3,5,4,4,5,1,4,12,4,8,3,2,5,6,4,
  34. 5,4,6,6,2,4,8,4,5,5,10,6,10,4,5,4,5,3,5,2,3,4,13,4,8,3,3,1,9,3,6,3,7,5,3,3,5,1,
  35. 3,3,5,5,4,2,5,5,11,3,6,3,5,4,10,3,14,4,8,3,12,3,6,4,6,5,3,3,5,2,2,4,4,6,4,2,5,
  36. 5,6,1,3,4,5,3,6,3,10,4,14,4,5,1,2,4,11,3,6,3,7,5,3,3,4,3,1,4,4,6,4,3,5,4,6,2,3,
  37. 3,6,3,5,4,9,4,15,3,5,2,3,4,9,3,6,4,7,4,3,3,5,2,2,3,4,7,3,3,6,3,6,3,2,4,5,4,5,3,
  38. 10,3,15,4,4,3,4,3,9,3,6,3,7,4,4,3,4,3,1,4,3,3,1,3,3,3,6,4,6,2,3,3,6,3,5,4,9,4,
  39. 15,4,4,3,4,4,7,3,6,4,7,4,3,3,4,3,2,3,3,3,2,3,2,4,5,5,5,3,2,4,6,3,5,4,8,4,16,4,
  40. 4,2,6,3,7,3,5,4,7,4,4,3,3,3,3,8,2,3,2,4,5,6,4,3,3,3,7,3,4,5,8,4,16,4,4,2,6,3,6,
  41. 3,5,4,8,3,5,8,3,9,2,3,1,4,6,6,3,3,4,3,7,3,3,6,7,4,17,4,4,3,5,3,6,3,4,4,9,3,5,8,
  42. 3,7,3,8,6,3,1,4,1,4,3,4,7,3,2,3,1,3,7,4,17,4,4,3,5,3,5,11,9,3,6,7,4,6,4,7,6,3,
  43. 2,8,4,3,8,7,2,3,6,4,18,3,5,4,3,4,5,10,10,3,6,6,6,4,4,6,7,3,4,6,5,3,8,7,2,4,4,4,
  44. 19,3,5,10,5,3,1,6,11,3,7,3,16,5,7,4,4,5,6,3,8,6,3,5,3,4,19,3,6,9,5,3,18,2,25,5,
  45. 9,3,6,3,7,2,10,3,6,4,3,3,20,3,8,5,6,3,44,6,10,2,39,3,3,2,22,2,19,3,43,7,101,3,
  46. 42,8,102,3,41,4,1,4,101,4,39,5,2,3,102,3,39,4,4,3,102,3,38,4,4,4,101,3,38,4,5,
  47. 3,102,3,37,4,5,4,101,4,36,4,6,3,102,3,37,3,6,4,102,3,36,4,6,3,102,3,37,3,6,3,
  48. 103,3,37,3,5,4,102,4,37,3,4,4,103,3,38,10,104,3,38,9,105,2,40,7,106,2,41,4,0);
  49.  
  50.  
  51. {──────────────────────────────────────────────────────────────────────────}
  52. Procedure InitChain4; ASSEMBLER;
  53.   {  This procedure gets you into Chain 4 mode }
  54. Asm
  55.     mov    ax, 13h
  56.     int    10h         { Get into MCGA Mode }
  57.  
  58.     mov    dx, 3c4h    { Port 3c4h = Sequencer Address Register }
  59.     mov    al, 4       { Index 4 = memory mode }
  60.     out    dx, al
  61.     inc    dx          { Port 3c5h ... here we set the mem mode }
  62.     in     al, dx
  63.     and    al, not 08h
  64.     or     al, 04h
  65.     out    dx, al
  66.     mov    dx, 3ceh
  67.     mov    al, 5
  68.     out    dx, al
  69.     inc    dx
  70.     in     al, dx
  71.     and    al, not 10h
  72.     out    dx, al
  73.     dec    dx
  74.     mov    al, 6
  75.     out    dx, al
  76.     inc    dx
  77.     in     al, dx
  78.     and    al, not 02h
  79.     out    dx, al
  80.     mov    dx, 3c4h
  81.     mov    ax, (0fh shl 8) + 2
  82.     out    dx, ax
  83.     mov    ax, 0a000h
  84.     mov    es, ax
  85.     sub    di, di
  86.     mov    ax, 0000h {8080h}
  87.     mov    cx, 32768
  88.     cld
  89.     rep    stosw            { Clear garbage off the screen ... }
  90.  
  91.     mov    dx, 3d4h
  92.     mov    al, 14h
  93.     out    dx, al
  94.     inc    dx
  95.     in     al, dx
  96.     and    al, not 40h
  97.     out    dx, al
  98.     dec    dx
  99.     mov    al, 17h
  100.     out    dx, al
  101.     inc    dx
  102.     in     al, dx
  103.     or     al, 40h
  104.     out    dx, al
  105.  
  106.     mov    dx, 3d4h
  107.     mov    al, 13h
  108.     out    dx, al
  109.     inc    dx
  110.     mov    al, [Size]      { Size * 8 = Pixels across. Only 320 are visible}
  111.     out    dx, al
  112. End;
  113.  
  114.  
  115. {──────────────────────────────────────────────────────────────────────────}
  116. Procedure C4PutPixel(X,Y : Word; Col : Byte); ASSEMBLER;
  117.   { This puts a pixel on the chain 4 screen }
  118. Asm
  119.     mov    ax,[y]
  120.     xor    bx,bx
  121.     mov    bl,[size]
  122.     imul   bx
  123.     shl    ax,1
  124.     mov    bx,ax
  125.     mov    ax, [X]
  126.     mov    cx, ax
  127.     shr    ax, 2
  128.     add    bx, ax
  129.     and    cx, 00000011b
  130.     mov    ah, 1
  131.     shl    ah, cl
  132.     mov    dx, 3c4h                  { Sequencer Register    }
  133.     mov    al, 2                     { Map Mask Index        }
  134.     out    dx, ax
  135.  
  136.     mov    ax, 0a000h
  137.     mov    es, ax
  138.     mov    al, [col]
  139.     mov    es: [bx], al
  140. End;
  141.  
  142. {──────────────────────────────────────────────────────────────────────────}
  143. Procedure Plane(Which : Byte); ASSEMBLER;
  144.   { This sets the plane to write to in Chain 4}
  145. Asm
  146.    mov     al, 2h
  147.    mov     ah, 1
  148.    mov     cl, [Which]
  149.    shl     ah, cl
  150.    mov     dx, 3c4h                  { Sequencer Register    }
  151.    out     dx, ax
  152. End;
  153.  
  154.  
  155. {──────────────────────────────────────────────────────────────────────────}
  156. procedure moveto(x, y : word);
  157.   { This moves to position x*4,y on a chain 4 screen }
  158. var o : word;
  159. begin
  160.   o := y*size*2+x;
  161.   asm
  162.     mov    bx, [o]
  163.     mov    ah, bh
  164.     mov    al, 0ch
  165.  
  166.     mov    dx, 3d4h
  167.     out    dx, ax
  168.  
  169.     mov    ah, bl
  170.     mov    al, 0dh
  171.     mov    dx, 3d4h
  172.     out    dx, ax
  173.   end;
  174. end;
  175.  
  176.  
  177.  
  178. {──────────────────────────────────────────────────────────────────────────}
  179. Procedure Putpic (x,y:integer);
  180.   { This put's the picture at coordinates x,y on the chain-4 screen }
  181. Var loop1,loop2:integer;
  182.     depth,cur:integer;
  183. BEGIN
  184.    depth:=1;
  185.    cur:=0;
  186.    For loop1:=1 to 897 do BEGIN
  187.      for loop2:=1 to bit [loop1] do BEGIN
  188.        if cur<>0 then c4putpixel ((depth mod 155)+x,(depth div 155)+y,depth div 155);
  189.        inc (depth);
  190.      END;
  191.      cur:=(cur+1) mod 2;
  192.    END;
  193. END;
  194.  
  195.  
  196. Procedure Play;
  197. Var loop1,loop2:integer;
  198.     xpos,ypos,xdir,ydir:integer;
  199.     ch:char;
  200. Begin
  201.    for loop1:=1 to 62 do
  202.      pal (loop1,loop1,0,62-loop1); { This sets up the pallette for the pic }
  203.  
  204.    MoveTo(0,0); { This moves the view to the top left hand corner }
  205.  
  206.    for loop1:=0 to 3 do
  207.      for loop2:=0 to 5 do
  208.        putpic (loop1*160,loop2*66); { This places the picture all over the
  209.                                       chain-4 screen }
  210.    readkey;
  211.    ch:=#0;
  212.    xpos:=random (78)+1;
  213.    ypos:=random (198)+1; { Random start positions for the view }
  214.    xdir:=1;
  215.    ydir:=1;
  216.    repeat
  217.      moveto (xpos,ypos);
  218.      waitretrace;          { Take this out and watch the screen go crazy! }
  219.      xpos:=xpos+xdir;
  220.      ypos:=ypos+ydir;
  221.      if (xpos>79) or (xpos<1) then xdir:=-xdir;
  222.      if (ypos>199) or (ypos<1) then ydir:=-ydir;  { Hit a boundry, change
  223.                                                     direction! }
  224.      if keypressed then ch:=readkey;
  225.    until ch=#27;  { Quit when escape is pressed }
  226. End;
  227.  
  228.  
  229. BEGIN
  230.   clrscr;
  231.   writeln ('Hello there! Here is the tenth tutorial, on Chain-4! You will notice');
  232.   writeln ('that there are two pascal files here : one is a unit containing all');
  233.   writeln ('our base graphics routines, and one is the demo program.');
  234.   writeln;
  235.   writeln ('In the demo program, we will do the necessary port stuff to get into');
  236.   writeln ('Chain-4. Once in Chain-4 mode, I will put down text saying ASPHYXIA');
  237.   writeln ('over the entire screen. After a key is pressed, the viewport will');
  238.   writeln ('bounce around, displaying the entire Chain-4 screen. The program will');
  239.   writeln ('end when [ESC] is pressed. The code here is really basic (except for');
  240.   writeln ('those port values), and should be very easy to understand.');
  241.   writeln;
  242.   writeln;
  243.   Write ('  Hit any key to contine ...');
  244.   Readkey;
  245.   initChain4;
  246.   play;
  247.   SetText;
  248.   Writeln ('All done. This concludes the tenth sample program in the ASPHYXIA');
  249.   Writeln ('Training series. You may reach DENTHOR under the names of GRANT');
  250.   Writeln ('SMITH/DENTHOR/ASPHYXIA on the ASPHYXIA BBS. I am also an avid');
  251.   Writeln ('Connectix BBS user, and occasionally read RSAProg. E-mail me at :');
  252.   Writeln ('    smith9@batis.bis.und.ac.za');
  253.   Writeln ('The numbers are available in the main text. You may also write to me at:');
  254.   Writeln ('             Grant Smith');
  255.   Writeln ('             P.O. Box 270');
  256.   Writeln ('             Kloof');
  257.   Writeln ('             3640');
  258.   Writeln ('             Natal');
  259.   Writeln ('             South Africa');
  260.   Writeln ('I hope to hear from you soon!');
  261.   Writeln; Writeln;
  262.   Write   ('Hit any key to exit ...');
  263.   Readkey;
  264. END.
  265.